c###inmuf.for
      SUBROUTINE INMUF(IHOP,NUMMOD)
C--------------------------------
C
C     THIS ROUTINE INSERTS OVER-THE-MUF OR ZERO DISTANCE MODES
C     IHOP WILL MATCH THE CORRECT NUMBER OF HOP ON SOME CALL
C     THE ROUTINE ASSURES SMOOTH TRANSITIONS
C
C  IF NO MODE IN REFLECTRIX ADD A OVER-THE-MUF MODE FOR EACH LAYER.
C
      COMMON/CON/D2R,DCL,GAMA,PI,PI2,PIO2,R2D,RZ,VOFL
      COMMON /DON /ALATD, AMIN, AMIND, BTR, BTRD, DLONG, DMP, ERTR, GCD,
     1 GCDKM, PMP, PWR, TLAT, TLATD, TLONG, TLONGD, RSN, SIGTR, RLAT,
     2 RLATD,RLONG,RLONGD,BRTD,FLUX,ULAT,ULATD,ULONG,ULONGD,SSN,D90R,
     3 D50R,D10R,D90S,D50S,D10S
      COMMON/FRQ/FREA(13),FREL(29),FREQ,JMODE,ITXRCP(2)
      COMMON/MODES/GHOP,DELMOD(6,3),HPMOD(6,3),HTMOD(6,3),FVMOD(6,3)
     A ,ITMOD(6,3),AFMOD(6,3)
      COMMON/MUFS/EMUF(24),F1MUF(24),F2MUF(24),ESMUF(24),ALLMUF(24),FOT
     A(24),XLUF(24),HPF(24),ANGMUF(24),MODMUF,SIGL(4),SIGU(4),DELMUF(4)
     B ,HPMUF(4),HTMUF(4),FVMUF(4),AFMUF(4),NHOPMF(4),YFOT(4),YHPF(4)
     A ,YMUF(4)
      COMMON /RON /CLAT(5), CLONG(5), GLAT(5), RD(5), FI(3,5), YI(3,5),
     1HI(3,5), HPRIM(30,5), HTRUE(30,5), FVERT(30,5),KM,KFX, AFAC(30,5),
     2HTR(50,3), FNSQ(50,3)
      COMMON/INFORM/INFO,IHSHR,IHLNG
C*****************************************************
      REAL*4 OSIGL(3),OSIGU(3),OYFOT(3),OYHPF(3),OYMUF(3)
      INTEGER*4 INM(3)
      character MODZ(3)*4, mlay(3,2)*4, HIMUFS(3)*7
      data mlay/'  E ',' F1 ',' F2 ','  Ex',' F1x',' F2x'/
      DATA EPS /.4001/
      K = JMODE
      IRESET=0
C.....WHAT LAYERS ARE IN.
      do 1 i=1,3
      INM(I)=-1
    1 MODZ(i)='    '
C.....BEINNING OF CHECK ON LAYER PRESENT
      INUM=0
      DO 125 IM = 1,6
C.....IF NO MODE BRANCH TO STATEMENT LABEL 125
      IF(HPMOD(IM,K) - 70.)  125,100,100
  100 INUM = INUM +1
      ITP=ITMOD(IM,K)
      INM(ITP)=1
      DELMOD(INUM,K) = DELMOD(IM,K)
      HPMOD (INUM,K) = HPMOD (IM,K)
      HTMOD (INUM,K) = HTMOD (IM,K)
      FVMOD (INUM,K) = FVMOD (IM,K)
      AFMOD (INUM,K) = AFMOD (IM,K)
      ITMOD (INUM,K) = ITMOD (IM,K)
  125 CONTINUE
      ISAV=INUM
C.....END OF CHECK ON LAYER PRESENT
C.....CHECK ON VERY SHORT DISTANCE (TAKE-OFF ANGLE .GE. 89.9)
      IF(DELMUF(MODMUF) .GE. 89.9)GO TO 250
      DO 150 ILY=1,3
C.....CHECK TO SEE IF F1 EXISTS
      IF(ILY.EQ.2.AND.FI(2,K).LE.0.)GO TO 150
C.....ALL THE LAYERS ARE IN IF 5 OR 6
      IF(INUM .GE. 5) GO TO 151
C.....CHECK IF LAYER(ILY) IS IN
      IF(INM(ILY).LT.0)THEN
C.......IF FREQ .GT. MUF AND THE NUMBER OF HOPS IS THE SAME INSERT MUF(ILY)
        IF( (FREQ+EPS).GE.YMUF(ILY).AND.IHOP.EQ.NHOPMF(ILY))THEN
C.........OVER-THE-MUF
C.........INSERT MUF(ILY) MODE
          INUM = INUM +1
          INEW=INUM-ISAV
          DELMOD(INUM,K) = DELMUF(ILY)
          HPMOD (INUM,K) = HPMUF (ILY)
          HTMOD (INUM,K) = HTMUF (ILY)
          FVMOD (INUM,K) = FVMUF (ILY)
          AFMOD (INUM,K) = AFMUF (ILY)
          ITMOD (INUM,K) = ILY
          INM(ILY)=1
          MODZ(INEW)=MLAY(ILY,1)
        ENDIF
      ENDIF
  150 CONTINUE
  151 IF(INUM.GT.ISAV)THEN
        IF(IAND(INFO,1).GT.0)THEN
          ghopkm=ghop*rz
         WRITE(99,'(16h "INMUF1"  Nhop=,I1,3x,6hHopkm=,f6.0,7h  Mods=,
     1    I1,3X,3A3)')IHOP,GHOPKM,INUM,(MODZ(II)(1:3),II=1,INEW)
        ENDIF
        do 152 i=1,3
  152   MODZ(i)='    '
        ISAV=INUM
      ENDIF
C.....CHECK ON ABOVE ABOVE THE MUF FOR THIS ORDER HOP
C.....FIND NEW MUF FOR MODE WITH THIS NUMBER OF HOPS
      IF(IHOP.EQ.NHOPMF(MODMUF))THEN
        IF(INUM.GT.0)THEN
          GO TO 275
        ELSE
          GO TO 250
        ENDIF
      ENDIF
C.....SAVE CIRCUIT MUF PARAMETERS
      IRESET=1
      DO 200 IL=1,3
      OSIGL(IL)=SIGL(IL)
      OSIGU(IL)=SIGU(IL)
      OYFOT(IL)=YFOT(IL)
      OYHPF(IL)=YHPF(IL)
  200 OYMUF(IL)=YMUF(IL)
C.....SET HIMUFS(JH) TO PRODUCE ***** IF NOT CALCULATED
      DO 201 JH=1,3
  201 HIMUFS(JH)='  *****'
      DO 240 JH=1,3
C.....ALL THE LAYERS ARE IN IF 5 OR 6
      IF(INUM .GE. 5) GO TO 241
C.....CHECK IF MODE FOR LAYER ALREADY EXISTS
      IF(INM(JH).GT.0)GO TO 240
C.....CHECK IF LAYER (F1) EXISTS
      IF(JH.EQ.2.AND.FI(2,K).LE.0.)GO TO 240
C.....CHECK IF HOP NUMBER LESS THAN OR EQUAL TO LAYER MUF HOPS
      IF(IHOP.LE.NHOPMF(JH))GO TO 240
      FV = FVMUF (JH)
      K = JMODE
      HT = HTMUF (JH)
      HPVER = XLIN(FV,FVERT,HPRIM,30,K)
      XHP = (HPVER - HT)/RZ
      HPNOW = HPVER
      NNOW = IHOP
      HOP = NNOW
      PSI = .5 *GCD/HOP
      TDEL = (COS(PSI) - RZ/(RZ + HPNOW     ))/ SIN(PSI)
      CDEL = 1. / SQRT (1. + TDEL * TDEL)
      SPHE = RZ * CDEL / (RZ + HT)
      SECP = 1. / SQRT(1. - SPHE * SPHE)
      ESD = FV * SECP
C.....CORRECTION TO MARTYN S THEOREM,SEE CURMUF
      FOB1 = ESD
      XMUT = SPHE*SPHE
      XFSQ = FOB1*FOB1/(FI(JH,K)*FI(JH,K) )
      SPH  =  XFSQ*XMUT*XHP*(HT+2.*(RZ+HT)*XHP)
C.....sph=amin1(sph,60.)
      IF(IAND(INFO,8).GT.0)THEN
        WRITE(99,'(A,I2,3(A,F8.2))')' "INMUF"  LAYER= ',JH,
     1  '  HP= ',HPVER,'  MARTYN CORR= ',SPH,'  FOB= ',FOB1
      ENDIF
      HPNOW   = HPVER + SPH
      TDEL = (COS(PSI) - RZ/(RZ + HPNOW     ))/ SIN(PSI)
      CDEL = 1. / SQRT (1. + TDEL * TDEL)
      SPHE = RZ * CDEL / (RZ + HT)
      SECP = 1. / SQRT(1. - SPHE * SPHE)
      ESD = FV * SECP
      WRITE(HIMUFS(JH),'(F7.2)')ESD
C.....CHECK IF FREQ IS ABOVE NEW MUF (ESD)
      IF (FREQ - ESD + EPS) 240,160,160
C.....NEW MUF HAS BEEN FOUND AND CAN BE USED
  160 CONTINUE
      YMUF(JH) = ESD
      SIGL(JH) = ESD * OSIGL(JH)/OYMUF(JH)
      YFOT(JH) = YMUF(JH) - 1.28 * SIGL(JH)
      SIGU(JH) = ESD * OSIGU(JH)/OYMUF(JH)
      YHPF(JH)= YMUF(JH) + 1.28*SIGU(JH)
      INUM=INUM+1
      INEW=INUM-ISAV
      DELMOD(INUM,K) = ATAN(TDEL) * R2D
      HPMOD(INUM,K) = HPNOW
      HTMOD(INUM,K) = HTMUF(JH)
      FVMOD(INUM,K) = FVMUF(JH)
      AFMOD(INUM,K) = AFMUF(JH)
      ITMOD(INUM,K) = JH
      MODZ(INEW)=MLAY(JH,1)
      GHOP = 2. * PSI
  240 CONTINUE
  241 IF(INUM.GT.ISAV)THEN
        IF(IAND(INFO,1).GT.0)THEN
          WRITE(99,'(A,3(I1,A2,1H=,A7,2X))')'  MUFS THIS HOP  ',
     1    (IHOP,MLAY(IL,1)(2:3),HIMUFS(IL),IL=1,3)
          ghopkm=ghop*rz
        WRITE(99,'(16h "INMUF2"  Nhop=,I1,3x,6hHopkm=,f6.0,7h  Mods=,
     1   I1,3X,3A3)')IHOP,GHOPKM,INUM,(MODZ(II)(1:3),II=1,INEW)
        ENDIF
      ENDIF
      GO TO 275
C  VERY SHORT DISTANCE, MAY NOT BE OVER MUF FOR F2 LAYER.
C  SO PROGRAM WILL DO ZERO DISTANCE WHICH MAY NOT BE IN THE REFLECTRIX
C  TABLE
  250 INUM = INUM +1
      INEW=INUM-ISAV
C.....BEGINNING OF SECTION TO ALWAYS FIND A MODE.
C.....THIS WILL REPRODUCE THE IONOGRAM
      FV = FREQ - 0.001
C.....INTERPOLATE IN IONOGRAM
C.....FIND FREQ IN TABLE
      FMAX=FVERT(1,K)
      DO 255 IH = 2,30
      IHX = IH
      IF(FVERT(IH,K).GT.FMAX)FMAX=FVERT(IH,K)
      IF( FV - FVERT(IH,K) ) 260,265,255
  255 CONTINUE
C.....FREQ ABOVE TABLE VALUES GO TO EXIT
      IF(IAND(INFO,1).GT.0)THEN
        WRITE(99,'(A,I4,2F7.2)')
     1'  FREQ ABOVE TABLE VALUES  K,FMAX,FREQ= ',K,FMAX,FREQ
      ENDIF
      GO TO 275
C.....INTERPOLATE BETWEEN TABLE VALUES
  260 SLOPE  = FVERT(IHX,K) - FVERT(IHX-1,K)
      IF(SLOPE .GT. 0.01 )THEN
        SLP = (FV -FVERT(IHX-1,K) ) / SLOPE
        DELMOD(INUM,K) = 90.0
        HPMOD(INUM,K)=HPRIM(IHX-1,K) +(HPRIM(IHX,K)-HPRIM(IHX-1,K))*SLP
        HTMOD(INUM,K)=HTRUE(IHX-1,K) + (HTRUE(IHX,K) - HTRUE(IHX-1,K) )
     1  * SLP
        FVMOD(INUM,K) = FV
        AFMOD(INUM,K)=AFAC (IHX-1,K) +(AFAC (IHX,K)- AFAC(IHX-1,K))*SLP
      ENDIF
      GO TO 270
C.....FOUND EXACT FREQ IN FVERT TABLE SO USE ENTRIES
  265 DELMOD(INUM,K) = 90.
      HPMOD (INUM,K) = HPRIM(IHX,K)
      HTMOD (INUM,K) = HTRUE(IHX,K)
      FVMOD (INUM,K) = FVERT(IHX,K)
      AFMOD (INUM,K) = AFAC (IHX,K)
  270 CONTINUE
      DO 272 ILY=1,3
      IF(ILY.EQ.2.AND.FI(2,K).LE.0.)GO TO 272
      IF(HTMOD(INUM,K).LE.HI(ILY,K))THEN
        ITMOD(INUM,K) = ILY
        MODZ(INEW)=MLAY(ILY,2)
        INM(ILY)=1
        GO TO 273
      ENDIF
  272 CONTINUE
      GO TO 275
C.....END OF SECTION TO FIND ZERO DISTANCE MODE.
  273 IF(IAND(INFO,1).GT.0)THEN
        HOPKM=GCDKM/NNOW
        WRITE(99,'(16h "INMUF3"  Nhop=,I1,3x,6hHopkm=,f6.0,7h  Mods=,
     1  I1,3X,A3)')NNOW,Hopkm,MODZ(1)(1:3),INUM
      ENDIF
  275 NUMMOD=0
      do 276 ilm=1,6
      if(HPMOD(ilm,k).lt.0.)go to 276
      NUMMOD=NUMMOD+1
  276 continue
      CALL REGMOD
      IF(IRESET.EQ.1)THEN
C.......RESTORE CIRCUIT MUF PARAMETERS
        DO 245 IL=1,3
        SIGL(IL)=OSIGL(IL)
        SIGU(IL)=OSIGU(IL)
        YFOT(IL)=OYFOT(IL)
        YHPF(IL)=OYHPF(IL)
  245   YMUF(IL)=OYMUF(IL)
      ENDIF
      RETURN
      END
C--------------------------------
